home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / brklyprl.lha / Emulator / Tests / Passed / test54.pl < prev    next >
Encoding:
Text File  |  1989-04-14  |  4.2 KB  |  140 lines
  1.  
  2. /* Copyright (C) 1988, 1989 Herve' Touati, Aquarius Project, UC Berkeley */
  3.  
  4. % preprocessing phase to eliminate disjunctions from the code
  5.  
  6. % takes a list of clauses of the form source(Name,Clause)
  7. % returns these clauses with disjunctions replaced by dummy calls
  8. % and a list of NewClauses corresponding to those dummy calls
  9. % Link is the uninstantiated last cdr of this list
  10.  
  11. main :- 
  12.     set(dummy_counter,0),
  13.     eliminate_disjunctions([(a:-(b;c))],X,Y,[]),
  14.     write((X,Y)), nl,
  15.     (X,Y) == ([(a:-'_dummy_0')],[('_dummy_0':-b),('_dummy_0':-c)]),
  16.     write(ok), nl.
  17.  
  18. eliminate_disjunctions(OneProc,NewProc,NewClauses,Link) :-
  19.     gather_disj(OneProc,NewProc,Disj,[]),
  20.     treat_disj(Disj,NewClauses,Link).
  21.  
  22. gather_disj([],[],Link,Link).
  23. gather_disj([C|Cs],NewProc,Disj,Link) :-
  24.     extract_disj(C, NewC, Disj, Rest),
  25.     NewProc = [NewC|NewCs],
  26.     gather_disj(Cs,NewCs,Rest,Link).
  27.  
  28. % given a clause, find in Disj the list of disj((A;B),N,X,C)
  29. % where N is a unique ID, X is a var that takes the place of
  30. % (A;B) in the code, NewC is the clause modified in such a way that
  31. % the disjunctions are replaced by the corresponding vars
  32. % Link is the last (uninstantiated) cdr of the list Disj.
  33. % do the work of pretrans for nots, -> etc...
  34. % put all those guys inside disjunctions 
  35. extract_disj(C, (Head:-NewBody), Disj, Link) :-
  36.     C = (Head:-Body), !,
  37.     access(dummy_counter,CtrIn),
  38.     extract_disj(Body, NewBody, Disj, Link, C, CtrIn, CtrOut),
  39.     set(dummy_counter,CtrOut).
  40. extract_disj(Head, Head, Link, Link).
  41.  
  42. extract_disj((C1,C2), (NewC1,NewC2), Disj, Link, C, CtrIn, CtrOut) :-
  43.     extract_disj(C1, NewC1, Disj, Link1, C, CtrIn, Ctr),
  44.     extract_disj(C2, NewC2, Link1, Link, C, Ctr, CtrOut).
  45.     
  46. extract_disj(Goal, X, Disj, Link, C, CtrIn, CtrOut) :-
  47.     is_disj(Goal,NewGoal), !,
  48.     Disj = [disj(NewGoal,CtrIn,X,C)|Link],
  49.     CtrOut is CtrIn + 1.
  50. extract_disj(Goal, Goal, Link, Link, _, CtrIn, CtrIn).
  51.  
  52. is_disj(((C1 -> C2); C3),((C1, !, C2); C3)) :- !.
  53. is_disj((C1;C2),(C1;C2)).
  54. is_disj(not(C),((C,!,fail);true)).
  55. is_disj(\+(C),((C,!,fail);true)).
  56. is_disj('\='(C1,C2),((C1 = C2,!,fail);true)).
  57.  
  58. % given a list of disj((A;B),N,X,C), for each, do the following:
  59. % 1) find vars in (A;B)
  60. % 2) find the vars in C
  61. % 3) intersect the two sets of vars into one list
  62. % 4) make a predicate name using N as a part of it ('dummy_disjN')
  63. % 5) put a structure with that name and those vars as args
  64. % 6) binds X to this call
  65. % 7) add new clauses [(dummy:-A)),(dummy:-B))]
  66. treat_disj([], Link, Link).
  67. treat_disj([disj((A;B),N,X,C)|Disjs], DummyClauses, Link) :-
  68.     find_vars((A;B),Vars),
  69.     find_vars(C,CVars),
  70.     intersect_vars(Vars,CVars,Args),
  71.     make_dummy_name(N,Name),
  72.     X =.. [Name|Args],
  73.     make_dummy_clauses((A;B),X,DummyClauses,Rest),
  74.     treat_disj(Disjs, Rest, Link).
  75.  
  76. make_dummy_clauses((A;B),X,[NewC|Cs],Link) :- 
  77.     !,
  78.     copy_term((X:-A), NewC),
  79.     make_dummy_clauses(B,X,Cs,Link).
  80. make_dummy_clauses(A,X,[NewC|Link],Link) :- copy_term((X:-A),NewC).
  81.  
  82. find_vars(X,Y) :- find_vars(X,Y,Link), Link = [].
  83.  
  84. find_vars(Var,[Var|Link],Link) :- var(Var), !.
  85. find_vars(Cst,Link,Link) :- atomic(Cst), !.
  86. find_vars([T|Ts],Vars,NewLink) :- !,
  87.     find_vars(T,Vars,Link),
  88.     find_vars(Ts,Link,NewLink).
  89. find_vars(Term,Vars,Link) :-
  90.     Term =.. [_|Args],
  91.     find_vars(Args,Vars,Link).
  92.  
  93. intersect_vars(V1,V2,Out) :-
  94.     sort_vars(V1,Sorted1),
  95.     sort_vars(V2,Sorted2),
  96.     intersect_sorted_vars(Sorted1,Sorted2,Out).
  97.  
  98. sort_vars(V,Out) :- sort_vars(V,Out,[]).
  99. sort_vars([],Link,Link).
  100. sort_vars([V|Vs],Result,Link) :-
  101.     split_vars(Vs,V,Smaller,Bigger),
  102.     sort_vars(Smaller,Result,[V|SLink]),
  103.     sort_vars(Bigger,SLink,Link).
  104.  
  105. split_vars([],_,[],[]).
  106. split_vars([V|Vs],A,[V|Ss],Bs) :-
  107.     V @< A, !,
  108.     split_vars(Vs,A,Ss,Bs).
  109. split_vars([V|Vs],A,Ss,Bs) :-
  110.     V == A, !,
  111.     split_vars(Vs,A,Ss,Bs).
  112. split_vars([V|Vs],A,Ss,[V|Bs]) :-
  113.     V @> A, !,
  114.     split_vars(Vs,A,Ss,Bs).
  115.  
  116. intersect_sorted_vars([],_,[]) :- !.
  117. intersect_sorted_vars(_,[],[]).
  118. intersect_sorted_vars([X|Xs],[Y|Ys],[X|Rs]) :-
  119.     X == Y, !,
  120.     intersect_sorted_vars(Xs,Ys,Rs).
  121. intersect_sorted_vars([X|Xs],[Y|Ys],Rs) :-
  122.     X @< Y, !,
  123.     intersect_sorted_vars(Xs,[Y|Ys],Rs).
  124. intersect_sorted_vars([X|Xs],[Y|Ys],Rs) :-
  125.     X @> Y, !,
  126.     intersect_sorted_vars([X|Xs],Ys,Rs).
  127.  
  128. make_dummy_name(N,Name) :-
  129.     name('_dummy_',L1),
  130.     name(N,L2),
  131.     append(L1,L2,L),
  132.     name(Name,L).
  133.  
  134. copy_term(C,Copy) :-
  135.     set(dummy,C),
  136.     access(dummy,Copy).
  137.  
  138. append([], L, L).
  139. append([H|L1], L2, [H|Res]) :- append(L1, L2, Res).
  140.